home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / shimweel.bas < prev    next >
BASIC Source File  |  1990-08-20  |  2KB  |  75 lines
  1.  '******************************************************************************
  2.  '* SHIMWEEL - Circle and palette demo.                                        *
  3.  '*                                                                            *
  4.  '* Written for GRAFIX by:  Joseph A. Albrecht                                 *
  5.  '*                                                                            *
  6.  '* Press F1 to restart program                                                *
  7.  '* Press F10 to toggle between 320 and 640 graphic modes                      *
  8.  '* Press ESC to exit program                                                  *
  9.  '******************************************************************************
  10.  '$INCLUDE: 'GRAFQBS.INC' 
  11.  'The above line is for QuickBASIC.
  12.  
  13.  ''$INCLUDE "GRAFTBS.INC"
  14.  'The above line is for TURBO BASIC. Remove the  ''  to compile the program.
  15.  
  16.  ''$INCLUDE "GRAFPBS.INC"
  17.  'The above line is for PowerBASIC. Remove the  ''  to compile the program.
  18.  
  19.  Graphics = 320
  20.  A = 110
  21.  
  22.  CALL GetTandy11(Tandy11%)
  23.  CALL MediumGraphics
  24.  
  25. Again:
  26.  RANDOMIZE TIMER
  27.  CALL ClearScreen
  28.  B = Graphics / 2
  29.  FOR I = A TO 50 STEP -4
  30.    C = INT(RND * 15) + 1
  31.    CALL ExtCircleC(B, 100, I, C)
  32.  NEXT I
  33.  CALL GetAspect(X, Y)
  34.  FOR I = 1 TO 92
  35.    D = INT(RND * 15) + 1
  36.    IF Graphics = 320 THEN
  37.      CALL SetAspect(15, 1)
  38.      CALL ExtCircleC(B, 100, I, D)
  39.      CALL SetAspect(1, 15)
  40.      CALL ExtCircleC(B, 100, I, D)
  41.    ELSE
  42.      CALL SetAspect(30, 1)
  43.      CALL ExtCircleC(B, 100, I * 2, D)
  44.      CALL SetAspect(1, 7)
  45.      CALL ExtCircleC(B, 100, I, D)
  46.    END IF
  47.  NEXT I
  48.  CALL SetAspect(X, Y)
  49.  
  50. Shimmer:
  51.  A$ = INKEY$
  52.  A$ = RIGHT$(A$, 1)
  53.  IF A$ = CHR$(27) THEN
  54.    CALL ExitGraphics
  55.    END
  56.  END IF
  57.  IF A$ = CHR$(68) AND Tandy11% = Tandy11.True% THEN
  58.    IF Graphics = 320 THEN
  59.      Graphics = 640
  60.      A = 220
  61.      CALL HighGraphics
  62.      GOTO Again
  63.    ELSE
  64.      Graphics = 320
  65.      A = 110
  66.      CALL MediumGraphics
  67.      GOTO Again
  68.    END IF
  69.  END IF
  70.  IF A$ = CHR$(59) THEN GOTO Again
  71.  CALL SetPalette(CINT(RND * 15) + 1, 0)
  72.  CALL Pause(2)
  73.  CALL ResetPalette
  74.  GOTO Shimmer
  75.